home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnats / gnats.el.z / gnats.el
Encoding:
Text File  |  1998-05-21  |  70.3 KB  |  2,037 lines
  1. ;;;; -*-emacs-lisp-*-
  2. ;;;; EMACS interface for GNATS.
  3. ;;;;  Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
  4. ;;;;  Contributed by Brendan Kehoe (brendan@cygnus.com)
  5. ;;;;   based on an original version by Heinz G. Seidl (hgs@ide.com).
  6. ;;;;
  7. ;;;; This file is part of GNU GNATS.
  8. ;;;;
  9. ;;;; GNU GNATS is free software; you can redistribute it and/or modify
  10. ;;;; it under the terms of the GNU General Public License as published by
  11. ;;;; the Free Software Foundation; either version 2, or (at your option)
  12. ;;;; any later version.
  13. ;;;;
  14. ;;;; GNU GNATS is distributed in the hope that it will be useful,
  15. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;;;; GNU General Public License for more details.
  18. ;;;;
  19. ;;;; You should have received a copy of the GNU General Public License
  20. ;;;; along with GNU GNATS; see the file COPYING.  If not, write to
  21. ;;;; the Free Software Foundation, 59 Temple Place - Suite 330,
  22. ;;;; Boston, MA 02111, USA.  */
  23.  
  24. ;;;; This file provides `edit-pr', `view-pr' `query-pr', for changing and
  25. ;;;; searching problem reports that are part of the GNATS database.  See the
  26. ;;;; gnats(1) man page or the GNATS documentation for further information.
  27.  
  28. (provide 'gnats)
  29. (require 'send-pr)            ;Shared stuff defined there
  30.  
  31. ;;;;---------------------------------------------------------------------------
  32. ;;;; Customization: put the following forms into your default.el file
  33. ;;;; (or into your .emacs) and the whole file into your EMACS library.
  34. ;;;;---------------------------------------------------------------------------
  35.  
  36. ;(autoload 'edit-pr "gnats"
  37. ;            "Command to edit a problem report." t)
  38.  
  39. ;(autoload 'view-pr "gnats"
  40. ;            "Command to view a problem report." t)
  41.  
  42. ;(autoload 'gnats-mode "gnats"
  43. ;      "Major mode for editing of problem reports." t)
  44.  
  45. ;(autoload 'query-pr "gnats"
  46. ;            "Command to query information about problem reports." t)
  47.  
  48. ;(autoload 'summ-pr "gnats"
  49. ;  "Command to display a summary listing of problem reports." t)
  50.  
  51. ;;;;---------------------------------------------------------------------------
  52. ;;;; To reply by mail within gnats-mode
  53. ;;;;---------------------------------------------------------------------------
  54.  
  55. (defvar gnats-mailer 'mail
  56.   "*Specifiles either `mail' or `mhe' as mailer for GNATS")
  57.   
  58. ;; Provides mail reply and mail other window command using usual mail
  59. ;; interface and mh-e interface.
  60. ;;
  61. ;; To use MAIL: set the variable
  62. ;; `gnats-mailer' to `mail'
  63. ;;
  64. ;; To use MH-E: set the variable 
  65. ;; `gnats-mailer' to  `mhe'
  66.  
  67. (autoload 'mail "sendmail")
  68. (autoload 'mail-other-window "sendmail")
  69. (autoload 'mail-fetch-field "mail-utils")
  70. (autoload 'rmail-dont-reply-to "mail-utils")
  71. (autoload 'mail-strip-quoted-names "mail-utils")
  72. (autoload 'mail-send "sendmail")
  73. (autoload 'mail-send-and-exit "sendmail")
  74.  
  75. (autoload 'mh-send "mh-e")
  76. (autoload 'mh-send-other-window "mh-e")
  77. (autoload 'mh-find-path "mh-e")
  78. (autoload 'mh-get-field "mh-e")
  79. (autoload 'mh-insert-fields "mh-e")
  80. (defvar mh-show-buffer nil)
  81. (defvar mh-sent-from-folder nil)
  82. (defvar mh-sent-from-msg nil)
  83.  
  84. ;;; User options
  85.  
  86. (defvar gnats:keep-edited-buffers t
  87.   "*If non-nil, then PR buffers are kept with distinct names after
  88. editing.  Otherwise, only the the most recently edited PR is kept.")
  89.  
  90. (defvar gnats:keep-sent-messages 1
  91.   "*Non-nil value N causes GNATS to keep the last N messages sent from GNATS.
  92. A value of 0 or nil causes GNATS never to keep such buffers.  A value of t
  93. causes GNATS to keep all such buffers.")
  94.  
  95. (defvar gnats:network-server nil
  96.   "*If non-nil, names the GNATS network server for remote queries and editing.")
  97.  
  98. (defvar gnats:run-in-background t
  99.   "*If non-nil, make GNATS programs run in the background allowing the emacs to continue to other things.")
  100.  
  101. (defvar gnats:bury-edited-prs t
  102.   "*If non-nil, then PR buffers are buried after editing.  Otherwise, they are left at the top of the buffer list.")
  103.  
  104. ;;; emacs 19 uses compile-internal, emacs 18 uses compile1
  105. (if gnats::emacs-19p
  106.     (autoload 'compile-internal "compile")
  107.   (autoload 'compile1 "compile")
  108.   (fset 'compile-internal 'compile1))
  109.  
  110. ;;; Misc constants.
  111.  
  112. ;;(defvar gnats:root "/usr/share/gnats/gnats-db"
  113. ;;  "*The top of the tree containing the GNATS database.")
  114.  
  115. (defvar gnats:libdir (or (gnats::get-config "LIBDIR") "/usr/lib")
  116.   "*Where the `gnats' subdirectory lives for things like pr-edit.")
  117.  
  118. (defvar gnats:addr (or (gnats::get-config "GNATS_ADDR") "bugs")
  119.   "*Where bug reports are sent.")
  120.  
  121. (defvar gnats::version
  122.   (concat "Version " (or (gnats::get-config "VERSION") "3.101")))
  123.  
  124. (defvar gnats::diffopt (or (gnats::get-config "DIFFOPT") "-u")
  125.   "How to get human-friendly output from diff(1).")
  126.  
  127. (defvar gnats::categories nil
  128.   "List of GNATS categories; computed at runtime.")
  129.  
  130. (defvar gnats::responsibles nil
  131.   "List of GNATS responsibles; Computed at runtime.")
  132.  
  133. (defvar gnats::submitters nil
  134.   "List of GNATS submitters; Computed at runtime.")
  135.  
  136. ;;;###autoload
  137. (defvar gnats::mode-name nil
  138.   "Name of the GNATS mode.")
  139.  
  140. (defconst gnats::err-buffer "*gnats-error*"
  141.   "Name of the temporary buffer, where gnats error messages appear.")
  142.  
  143. ;;(defconst gnats::indent 17 "Indent for formatting the value.")
  144.  
  145. (defvar gnats:::pr-locked nil
  146.   "Buffer local flag representing whether the associated pr is locked.")
  147.  
  148. (defvar gnats:::pr-errors nil
  149.   "Buffer local buffer holding any errors from attempting to file this pr.")
  150.  
  151. (defvar gnats:::buffer-pr nil
  152.   "Buffer local name of this pr.")
  153.  
  154. (defvar gnats:::current-pr nil
  155.   "Buffer local value of the current pr.")
  156.  
  157. (defvar gnats:::do-file-pr nil
  158.   "Buffer local value; if T, file the current pr.")
  159.  
  160. (defvar gnats:::force nil
  161.   "Buffer local value; if T, ignore errors unlocking the current pr.")
  162.  
  163. (defvar gnats:::pr-buffer nil
  164.   "Buffer local value of the buffer containing the pr.")
  165.  
  166. (defvar gnats:::audit-trail nil
  167.   "Buffer local audit trail for the current pr.")
  168.  
  169. (defvar gnats:::backupname nil
  170.   "Buffer local name of the backup file for this pr.")
  171.  
  172. (defvar gnats:::start-of-PR-fields nil
  173.   "Buffer position of the beginning of the PR fields.")
  174.  
  175. (defvar gnats:::newfile nil
  176.   "File used to store the results of npr-edit.")
  177.  
  178. (defvar gnats:::query-pr "query-pr"
  179.   "The program name used to query problem reports.")
  180.  
  181. (defvar gnats:::nquery-pr "nquery-pr"
  182.   "The program name used to query problem reports over the network.")
  183.  
  184. (defvar gnats:::query-regexp "n?query-pr:"
  185.   "The regular expression to use to recognize a message from the query program.")
  186.  
  187. ;; For example:
  188. ;;  (setq gnats:::types '( ( "Games" ( "/gnats/games"  "/usr/gamesdb/H-sun4/lib ")
  189. ;;                        ( "Tools" ( "/usr/toolsdb" "/usr/local/lib" ))))
  190. (defvar gnats:::types nil
  191.   "Alist of each type of GNATS database and its root and libdir settings.")
  192.  
  193. (defconst gnats::fields
  194.   (let (fields)
  195.     (setq
  196.      fields
  197.      ;; Duplicate send-pr::fields, don't just include it.
  198.      ;; is there a better way than this?
  199.      (append (read (prin1-to-string send-pr::fields))
  200.          '(("Arrival-Date" nil nil text)
  201.            ("Customer-Id")
  202.            ("Number" nil nil number)
  203.            ("Responsible" gnats::set-responsibles nil enum
  204.         gnats::update-audit-trail)
  205.            ("State"
  206.         (("open") ("analyzed") ("feedback") ("suspended") ("closed"))
  207.         (lambda (x) (or (cdr (assoc x gnats::state-following)) ""))
  208.         enum gnats::update-audit-trail))))
  209.     ;; (setf (second (assoc "Category" fields)) 'gnats::set-categories)
  210.     (setcar (cdr (assoc "Category" fields)) 'gnats::set-categories)
  211.     (setcdr (nthcdr 3 (assoc "Category" fields))
  212.         '(gnats::update-responsible))
  213.     (setcar (cdr (assoc "Class" fields))
  214.         '(("sw-bug") ("doc-bug") ("change-request") ("support")
  215.           ("mistaken") ("duplicate")))
  216.     (setcdr (assoc "Submitter-Id" fields) '(gnats::set-submitters t enum))
  217.     (setcdr (assoc "Customer-Id" fields) (cdr (assoc "Submitter-Id" fields)))
  218.     fields)
  219.   "AList of one-line PR fields and their possible values.")
  220.  
  221. (defconst gnats::state-following 
  222.   '(("open"      . "analyzed")
  223.     ("analyzed"  . "feedback")
  224.     ("feedback"  . "closed")
  225.     ("suspended" . "analyzed"))
  226.   "A list of states and possible following states (does not describe all
  227. possibilities).")
  228.  
  229. (defvar gnats::query-pr-history nil
  230.   "Past arguments passed to the query-pr program.")
  231.  
  232. (defvar gnats::tmpdir (or (getenv "TMPDIR") "/tmp/")
  233.   "Directory to use for temporary files.")
  234.  
  235. ;;;;---------------------------------------------------------------------------
  236. ;;;; hooks
  237. ;;;;---------------------------------------------------------------------------
  238.  
  239. ;; we define it here in case it's not defined
  240. (or (boundp 'text-mode-hook) (setq text-mode-hook nil))
  241. (defvar gnats-mode-hook text-mode-hook "Called when gnats mode is switched on.")
  242.  
  243. ;;;;---------------------------------------------------------------------------
  244. ;;;; Error conditions
  245. ;;;;---------------------------------------------------------------------------
  246.  
  247. (put 'gnats::error 'error-conditions '(error gnats::error))
  248. (put 'gnats::error 'error-message "GNATS error")
  249.  
  250. ;; pr-edit --check was unhappy
  251. (put 'gnats::invalid-fields 'error-conditions
  252.      '(error gnats::error gnats::invalid-fields))
  253. (put 'gnats::invalid-fields 'error-message "invalid fields in PR")
  254. (put 'gnats::invalid-date 'error-conditions
  255.      '(error gnats::error gnats::invalid-date))
  256. (put 'gnats::invalid-date 'error-message "invalid date value")
  257.  
  258. ;; pr-addr couldn't find an appropriate address
  259. (put 'gnats::invalid-name 'error-conditions
  260.      '(error gnats::error gnats::invalid-name))
  261. (put 'gnats::invalid-name 'error-message "could not find the requested address")
  262.  
  263. ;; what pr?
  264. (put 'gnats::no-such-pr 'error-conditions '(error gnats::error gnats::no-such-pr))
  265. (put 'gnats::no-such-pr 'error-message "PR does not exist")
  266.  
  267. ;;
  268. (put 'gnats::no-such-category 'error-conditions
  269.      '(error gnats::error gnats::no-such-category))
  270. (put 'gnats::no-such-category 'error-message "No such category")
  271.  
  272. ;; there is no lock on that pr
  273. (put 'gnats::pr-not-locked 'error-conditions
  274.      '(error gnats::error gnats::pr-not-locked))
  275. (put 'gnats::pr-not-locked 'error-message "No one is locking the PR")
  276.  
  277. ;; there is a lock on that pr
  278. (put 'gnats::locked-pr 'error-conditions '(error gnats::error gnats::locked-pr))
  279. (put 'gnats::locked-pr 'error-message "PR locked by")
  280.  
  281. ;; GNATS is locked
  282. (put 'gnats::locked 'error-conditions '(error gnats::error gnats::locked))
  283. (put 'gnats::locked 'error-message "GNATS is locked by another process---try again later.")
  284.  
  285. ;; We can't lock GNATS.
  286. (put 'gnats::cannot-lock 'error-conditions '(error gnats::error gnats::locked))
  287. (put 'gnats::cannot-lock 'error-message "cannot lock GNATS; try again later.")
  288.  
  289. ;;;;---------------------------------------------------------------------------
  290. ;;;; GNATS mode
  291. ;;;;---------------------------------------------------------------------------
  292.  
  293. (defvar gnats-mode-map
  294.   (let ((map (make-sparse-keymap)))
  295.     (define-key map "\M-n" 'gnats:next-field)
  296.     (define-key map "\M-p" 'gnats:previous-field)
  297.     (define-key map "\C-\M-b" 'gnats:backward-field)
  298.     (define-key map "\C-\M-f" 'gnats:forward-field)
  299.     (define-key map "\C-c\C-a" 'gnats:mail-reply)
  300.     (define-key map "\C-c\C-c" 'gnats:submit-pr)
  301.     (define-key map "\C-c\C-e" 'gnats:edit-pr)
  302.     (define-key map "\C-c\C-f" 'gnats:change-field)
  303.     (define-key map "\C-c\C-m" 'gnats:mail-other-window)
  304.     (define-key map "\C-c\C-q" 'gnats:unlock-buffer-force)
  305.     (define-key map "\C-c\C-r" 'gnats:responsible-change-from-to)
  306.     (define-key map "\C-c\C-s" 'gnats:state-change-from-to)
  307.     (define-key map "\C-c\C-t" 'gnats:category-change-from-to)
  308.     (define-key map "\C-c\C-u" 'gnats:unlock-pr)
  309.     (or gnats::emacs-19p
  310.     (define-key map "\C-xk" 'gnats:kill-buffer))
  311.     map)
  312.   "Keymap for gnats mode.")
  313.  
  314. (defsubst gnats::get-header (field)
  315.   "Fetch the contents of mail header FIELD."
  316.   (funcall (nth 4 (assoc gnats-mailer gnats::mail-functions)) field))
  317.  
  318. (defun gnats:submit-pr ()
  319.   "Save the current PR into the database and unlock it.
  320.  
  321. This function has no effect if the PR is not locked.
  322.  
  323. Three cases:
  324.       State change
  325.       Responsibility change
  326.       Other change (only interesting if the PR was changed by somebody 
  327.                     other than the Reponsible person)
  328.  
  329. State changes are sent to the originator
  330. Responsibility changes are sent to the new responsible person
  331. Other changes are sent to the responsible person."
  332.   ;;
  333.   (interactive)
  334.   (cond ((not (eq major-mode 'gnats:gnats-mode))
  335.      (error "edit-pr: not in GNATS mode.")) 
  336.     (gnats:::pr-locked
  337.      (gnats::check-pr-background t)
  338.      (if gnats:run-in-background (bury-buffer)))
  339.       ;; If not locked, do nothing
  340.     (t
  341.      (message "edit-pr: PR not locked."))))
  342.  
  343. ;;;###autoload
  344. (setq gnats::mode-name 'gnats:gnats-mode)
  345.  
  346. (defun gnats::rename-buffer ()
  347.   (let ((category (gnats::field-contents "Category"))
  348.     (number   (gnats::field-contents "Number"))
  349.     buf)
  350.     (setq gnats:::buffer-pr (format "%s/%s" category number))
  351.     (and (setq buf (get-buffer gnats:::buffer-pr))
  352.      (save-excursion
  353.        (set-buffer buf)
  354.        (set-buffer-modified-p nil)
  355.        (kill-buffer buf)))
  356.     (rename-buffer gnats:::buffer-pr)))
  357.  
  358. ;; FIXME allow re-lock of unlocked PR
  359. ;; FIXME too many assumptions -- make more independent of edit-pr
  360. ;;;###autoload
  361. (fset 'gnats-mode gnats::mode-name)
  362. ;;;###autoload
  363. (defun gnats:gnats-mode ()
  364.   "Major mode for editing problem reports.
  365. For information about the form see gnats(1) and pr_form(5).
  366.  
  367. When you are finished editing the buffer, type \\[gnats:submit-pr] to commit
  368. your changes to the PR database.  To abort the edit, type
  369. \\[gnats:unlock-buffer].
  370.  
  371. Special commands:
  372. \\{gnats-mode-map}
  373. Turning on gnats-mode calls the value of the variable gnats-mode-hook,
  374. if it is not nil."
  375.   (gnats::patch-exec-path)        ;Why is this necessary? --jason
  376.   (gnats::set-categories)
  377.   (gnats::set-responsibles)
  378.   (gnats::set-submitters)
  379.   (put gnats::mode-name 'mode-class 'special)
  380.   (kill-all-local-variables)
  381.   (setq major-mode gnats::mode-name)
  382.   (setq mode-name "gnats")
  383.   (use-local-map gnats-mode-map)
  384.   (set-syntax-table text-mode-syntax-table)
  385.   (setq local-abbrev-table text-mode-abbrev-table)
  386.   (make-local-variable 'gnats:::start-of-PR-fields)
  387.   (make-local-variable 'gnats:::pr-errors)
  388.   (make-local-variable 'gnats:::buffer-pr)
  389.   (gnats::rename-buffer)
  390.  
  391.   ;; we do this in gnats:edit-pr for the network version
  392.   (if (not gnats:network-server)
  393.       (progn
  394.     (setq gnats:::backupname (gnats::make-temp-name))
  395.     (copy-file (format "%s/%s" gnats:root gnats:::buffer-pr)
  396.            gnats:::backupname)))
  397.   
  398.   ;; edit-pr locks it for us
  399.   (make-local-variable 'gnats:::pr-locked)
  400.   (setq gnats:::pr-locked t)
  401.  
  402.   (cond (gnats::emacs-19p
  403.      (make-local-variable 'kill-buffer-hook)
  404.      (add-hook 'kill-buffer-hook 'gnats::kill-buffer-hook)))
  405.  
  406.   ; If they do C-x C-c, unlock all of the PRs they've edited.
  407.   (if (fboundp 'add-hook)
  408.       (add-hook 'kill-emacs-hook 'gnats::unlock-all-buffers)
  409.     (setq kill-emacs-hook 'gnats::unlock-all-buffers))
  410.  
  411.   (make-local-variable 'paragraph-separate)
  412.   (setq paragraph-separate (concat (default-value 'paragraph-separate)
  413.                     "\\|" gnats::keyword "$"))
  414.   (make-local-variable 'paragraph-start)
  415.   (setq paragraph-start (concat (default-value 'paragraph-start)
  416.                 "\\|" gnats::keyword))
  417.   (make-local-variable 'gnats:::audit-trail)
  418.   (goto-char (point-min))
  419.   (search-forward "\n>Number:")
  420.   (beginning-of-line)
  421.   (setq gnats:::start-of-PR-fields (point-marker))
  422.   (run-hooks 'gnats-mode-hook))
  423.  
  424. ;;;;---------------------------------------------------------------------------
  425. ;;;; Mail customization
  426. ;;;;---------------------------------------------------------------------------
  427.  
  428. (or (string-match mail-yank-ignored-headers "X-mode:")
  429.     (setq mail-yank-ignored-headers 
  430.       (concat "^X-mode:" "\\|" mail-yank-ignored-headers)))
  431.  
  432. (defconst gnats::mail-functions
  433.   '((mail gnats::mail-other-window-using-mail
  434.       gnats::mail-reply-using-mail
  435.       gnats::mail-PR-changed-mail-setup
  436.       gnats::get-header-using-mail-fetch-field)
  437.     (mhe  gnats::mail-other-window-using-mhe
  438.       gnats::mail-reply-using-mhe
  439.       gnats::mail-PR-changed-mhe-setup
  440.       gnats::get-header-using-mhe))
  441.   "An association list of mailers and the functions that use them.
  442. The functions are supposed to implement, respectively:
  443. gnats::mail-other-window
  444. gnats::mail-reply
  445. gnats::mail-PR-changed-setup
  446. gnats::get-header")
  447.  
  448. ;;;;---------------------------------------------------------------------------
  449. ;;;; Toplevel functions and vars, to reply with mail within gnats-mode
  450. ;;;;---------------------------------------------------------------------------
  451.  
  452. (defun gnats:mail-other-window ()
  453.   "Compose mail in other window.
  454. Customize the variable `gnats-mailer' to use another mailer."
  455.   ;;
  456.   (interactive)
  457.   (funcall (nth 1 (assoc gnats-mailer gnats::mail-functions))))
  458.  
  459. (defun gnats:mail-reply (&optional just-sender)
  460.   "Reply mail to PR Originator.
  461. Customize the variable `gnats-mailer' to use another mailer.
  462. If optional argument JUST-SENDER is non-nil, send response only to
  463. original submitter of problem report."
  464.   ;;
  465.   (interactive "P")
  466.   (funcall (nth 2 (assoc gnats-mailer gnats::mail-functions)) just-sender))
  467.  
  468. ;;;; common (and suppport) functions 
  469.  
  470. (defun gnats::isme (addr)
  471.   (setq addr (mail-strip-quoted-names addr))
  472.   (or (string= addr (user-login-name))
  473.       (string= addr (concat (user-login-name) "@" (system-name)))))
  474.   
  475. (defsubst gnats::mail-PR-changed-setup (to subject cc buffer)
  476.   (funcall (nth 3 (assoc gnats-mailer gnats::mail-functions))
  477.        to subject cc buffer))
  478.  
  479. (defun gnats::mail-PR-changed-mail-setup (to subject cc buffer)
  480.   (or (gnats::vmish-mail
  481.        (format "notification of changes to PR %s" gnats:::buffer-pr)
  482.        nil to subject nil cc buffer)
  483.       (error "Submit aborted; PR is still locked.")))
  484.  
  485. (defun gnats::mail-PR-changed-mhe-setup (to subject cc buffer)
  486.   (let ((config (current-window-configuration))
  487.     (pop-up-windows t)
  488.     draft)
  489.     (mh-find-path)
  490.     (let ((pop-up-windows t))
  491.       (mh-send-sub to (or cc "") subject config))
  492.     (switch-to-buffer (current-buffer))
  493.     (setq mh-sent-from-folder buffer
  494.       mh-sent-from-msg 1
  495.       mh-show-buffer buffer)))
  496.  
  497. (defun gnats::mail-PR-changed (user responsible resp-change state-change notify)
  498.   "- Send mail to the responsible person if the PR has been changed
  499.   by someone else
  500. - Send mail to the originator when the state is changed.
  501. - Send mail to old and new responsible people when the responsibility is
  502.   transferred.
  503.   `resp-change' is the list (old-resp new-resp start end)
  504. - Send mail to any other parties in NOTIFY."
  505.   ;; This function is really ugly !
  506.   ;;
  507.   (let ((to nil)
  508.     (cc nil)
  509.     (subn nil) (subm nil)
  510.     (subject (gnats::get-reply-subject))
  511.     (buffer  (current-buffer))
  512.     (pr-change (not (or resp-change state-change)))
  513.     (pr-backupname gnats:::backupname)
  514.     )
  515.     ;; Here we find out where to send the mail to
  516.     (let (to-resp to-new-resp to-submitter to-bugs resp-addr new-resp-addr)
  517.       (if pr-change (setq to-resp t to-bugs t)
  518.     (if resp-change (setq to-resp t to-new-resp t))
  519.     (if state-change (setq to-submitter t to-resp t)))
  520.       (cond (to-new-resp
  521.          (setq new-resp-addr (gnats::pr-addr (car resp-change)))
  522.          (if (gnats::isme new-resp-addr)
  523.          (setq to-new-resp nil))))
  524.       (cond (to-resp
  525.          (setq resp-addr (gnats::pr-addr responsible))
  526.          (if (gnats::isme resp-addr)
  527.          (setq to-resp nil))))
  528.       (cond (to-submitter
  529.          (setq cc to)
  530.          (setq to (list (gnats::get-reply-to)))))
  531.       (if to-resp (gnats::push resp-addr to))
  532.       (if to-new-resp (gnats::push new-resp-addr to))
  533.       (setq subm (or (gnats::field-contents "Customer-Id")
  534.              (gnats::field-contents "Submitter-Id")))
  535.       (if subm
  536.       (progn
  537.         (setq subn (nth 5 (assoc subm gnats::submitters)))
  538.         (if (not (string= subn ""))
  539.         (gnats::push subn cc))))
  540.       (if to-bugs (gnats::push gnats:addr cc))
  541.       (if notify (gnats::push notify cc))
  542.       (setq to (mapconcat 'identity to ", ")
  543.         cc (mapconcat 'identity cc ", "))
  544.       (if (string= cc "") (setq cc nil)))
  545.     (gnats::mail-PR-changed-setup to subject cc buffer)
  546.     ;; now we assume that the current buffer is the mail buffer
  547.     (goto-char (point-max))
  548.     (if pr-change
  549.     (progn
  550.       (insert 
  551.        (format "\n\t`%s' made changes to this PR.\n\n" (user-full-name)))
  552.       (if (and pr-backupname (file-readable-p pr-backupname))
  553.           (let ((file (gnats::make-temp-name))
  554.             (default-directory (gnats::find-safe-default-directory)))
  555.         (save-excursion
  556.           (set-buffer buffer)
  557.           (write-region (point-min) (point-max) file))
  558.         (call-process "diff" nil t t gnats::diffopt
  559.                   pr-backupname file)
  560.         (delete-file file))))
  561.       (if resp-change
  562.       (progn
  563.         (insert (format "\n\t`%s' changed the responsibility to `%s'.\n" 
  564.                 (user-full-name) responsible))
  565.         (insert-buffer-substring buffer 
  566.                      (nth 2 resp-change) 
  567.                      (nth 3 resp-change)))
  568.     (if state-change
  569.         (progn
  570.           (insert (format "\n\t`%s' changed the state to `%s'.\n" 
  571.                   (user-full-name) (nth 1 state-change)))
  572.           (insert-buffer-substring buffer 
  573.                        (nth 2 state-change)
  574.                        (nth 3 state-change))))))
  575.     ))
  576.  
  577. (defsubst gnats::bm (num)
  578.   (buffer-substring (match-beginning num) (match-end num)))
  579.  
  580. (defun gnats::real-pr-addr (name)
  581.   (if (zerop (length name))
  582.       nil
  583.     (let ((buf (generate-new-buffer gnats::err-buffer)))
  584.       (unwind-protect
  585.       (save-excursion
  586.         (let ((default-directory (gnats::find-safe-default-directory)))
  587.           (call-process (format "%s/gnats/pr-addr" gnats:libdir)
  588.                 nil buf nil "-F" name))
  589.         (set-buffer buf)
  590.         (goto-char (point-min))
  591.         (cond ((looking-at "pr-addr: could not find the requested address")
  592.            nil)
  593.           ((looking-at "^\\([^:]*\\):\\([^:]*\\):\\([^:]*\\)\n")
  594.            (list (gnats::bm 1) (gnats::bm 2) (gnats::bm 3)))
  595.           (t (signal 'gnats::error
  596.                  (list (buffer-substring (point-min)
  597.                              (1- (point-max))))))))
  598.     (kill-buffer buf)))))
  599.  
  600. (defun gnats::pr-addr (name)
  601.   "Find the e-mail address corresponding to maintainer NAME."
  602.   (let (entry addr)
  603.     (or (setq entry (assoc name gnats::responsibles))
  604.     (and (setq entry (gnats::real-pr-addr name))
  605.          (gnats::push entry gnats::responsibles))
  606.     (signal 'gnats::invalid-name (list name)))
  607.     (setq addr (if (zerop (length (nth 2 entry)))
  608.            name
  609.          (nth 2 entry)))
  610.     (if (zerop (length (nth 1 entry)))
  611.     addr
  612.       (concat (nth 1 entry) " <" addr ">"))))
  613.  
  614. (defun gnats::get-header-using-mail-fetch-field (field)
  615.   (save-excursion
  616.     (save-restriction
  617.       (goto-char (point-min))
  618.       (re-search-forward "^$" nil 'move)
  619.       (narrow-to-region (point-min) (point))
  620.       (mail-fetch-field field))))
  621.       
  622. (defun gnats::get-header-using-mhe (field)
  623.   (save-excursion
  624.     (let ((ret (mh-get-field (concat field ":"))))
  625.       (if (string= ret "")
  626.       nil
  627.     ret))))
  628.  
  629. (defun gnats::get-reply-to ()
  630.   (or (gnats::get-header "Reply-To")
  631.       (gnats::get-header "From")))
  632.  
  633. (defun gnats::get-reply-subject ()
  634.   (save-excursion
  635.     (save-restriction
  636.       (widen)
  637.       (let ((category (gnats::field-contents "Category"))
  638.         (number   (gnats::field-contents "Number"))
  639.         (synopsis (gnats::field-contents "Synopsis" 0))
  640.         (subject))
  641.     (goto-char (point-min))
  642.     (narrow-to-region (point-min)
  643.               (progn (search-forward "\n\n" nil 'move)
  644.                  (point-marker)))
  645.     (setq subject (mail-fetch-field "subject"))
  646.     (if (and synopsis (not (equal synopsis "")))
  647.         (format "Re: %s/%s: %s" category number synopsis)
  648.       (format "Re: %s/%s: %s" category number subject))))))
  649.  
  650. (defun gnats::make-in-reply-to-field (from date msg-id)
  651.   (concat
  652.    (substring from 0 (string-match "  *at \\|  *@ \\| *(\\| *<" from))
  653.    "'s message of " date
  654.    (if (not (equal msg-id ""))
  655.        (concat "\n             " msg-id)
  656.      "")))
  657.  
  658. ;;;; Send mail using sendmail mail mode.
  659.  
  660. (defun gnats::mail-reply-using-mail (just-sender)
  661.   ;;
  662.    "Mail a reply to the originator of the PR.
  663. Normally include CC: to all other recipients of original message;
  664. argument means ignore them.
  665. While composing the reply, use \\[mail-yank-original] to yank the
  666. original message into it."
  667.    ;;
  668.    (let (from cc subject date to reply-to msg-id)
  669.      (save-excursion
  670.        (save-restriction
  671.      (widen)
  672.      (narrow-to-region (point-min) (progn (goto-char (point-min))
  673.                           (search-forward "\n\n")
  674.                           (- (point) 1)))
  675.      (setq from       (mail-fetch-field "from" nil t)
  676.            subject    (gnats::get-reply-subject)
  677.            reply-to   (or (mail-fetch-field "reply-to" nil t)
  678.                   from)
  679.            date       (mail-fetch-field "date" nil t)
  680.            cc         (cond (just-sender nil)
  681.                 (t (mail-fetch-field "cc" nil t)))
  682.            to         (or (mail-fetch-field "to" nil t)
  683.                   (mail-fetch-field "apparently-to" nil t)
  684.                   "")
  685.            msg-id     (mail-fetch-field "message-id")
  686.            )))
  687.      (gnats::vmish-mail-other-window
  688.       (format "reply to PR %s" gnats:::buffer-pr)
  689.       nil (mail-strip-quoted-names reply-to) subject
  690.       (gnats::make-in-reply-to-field from date msg-id)
  691.       (if just-sender
  692.       nil
  693.     (let* ((cc-list (rmail-dont-reply-to (mail-strip-quoted-names
  694.                           (if (null cc) to 
  695.                         (concat to ", " cc))))))
  696.       (if (string= cc-list "") nil cc-list)))
  697.       (current-buffer))))
  698.  
  699. (defun gnats::mail-other-window-using-mail ()
  700.   "Send mail in another window.
  701. While composing the message, use \\[mail-yank-original] to yank the
  702. original message into it."
  703.   (gnats::vmish-mail-other-window 
  704.    (format "mail regarding PR %s" gnats:::buffer-pr)
  705.    nil nil (gnats::get-reply-subject) nil nil (current-buffer)))
  706.  
  707. ;; This must be done in two toplevel forms because of a 19.19 byte-compiler
  708. ;; bug.
  709. (defun gnats::generate-new-buffer-name (prefix)
  710.   (let ((name prefix) (n 1))
  711.     (while (get-buffer name)
  712.       (setq name (format "%s<%d>" prefix n))
  713.       (setq n (1+ n)))
  714.     name))
  715.  
  716. (if (fboundp 'generate-new-buffer-name)
  717.     (fset 'gnats::generate-new-buffer-name 'generate-new-buffer-name))
  718.  
  719. (defvar gnats::kept-mail-buffers nil
  720.   "Sent mail buffers waiting to be killed.")
  721.  
  722. (defun gnats::vmish-rename-after-send ()
  723.   (or (string-match "^sent " (buffer-name))
  724.       (rename-buffer (gnats::generate-new-buffer-name
  725.               (format "sent %s" (buffer-name)))))
  726.  
  727.   ;; Mostly lifted from vm-reply.el 5.35
  728.   (setq gnats::kept-mail-buffers
  729.     (cons (current-buffer) gnats::kept-mail-buffers))
  730.   (if (not (eq gnats:keep-sent-messages t))
  731.       (let ((extras (nthcdr (or gnats:keep-sent-messages 0)
  732.                 gnats::kept-mail-buffers)))
  733.     (mapcar (function (lambda (b) (and (buffer-name b) (kill-buffer b))))
  734.         extras)
  735.     (and gnats::kept-mail-buffers extras
  736.          (setcdr (memq (car extras) gnats::kept-mail-buffers) nil)))))
  737.  
  738. (if gnats::emacs-19p
  739.     (defun gnats::vmish-mail-bindings ())
  740.   (defun gnats::vmish-mail-send ()
  741.     (interactive)
  742.     (gnats::vmish-rename-after-send)
  743.     (mail-send))
  744.   (defun gnats::vmish-mail-send-and-exit (arg)
  745.     (interactive "P")
  746.     (gnats::vmish-rename-after-send)
  747.     (mail-send-and-exit arg))
  748.   (defun gnats::vmish-mail-bindings ()
  749.     (use-local-map (copy-keymap (current-local-map)))
  750.     (local-set-key "\C-c\C-s" 'gnats::vmish-mail-send)
  751.     (local-set-key "\C-c\C-c" 'gnats::vmish-mail-send-and-exit))
  752.   (defun string-to-number (str) (string-to-int str)))
  753.  
  754. ;; ignore 'free variable' warnings about buf.
  755. (defsubst gnats::vmish-rename-mail-buffer (buf)
  756.   (save-excursion
  757.     (set-buffer buf)
  758.     (setq buf (gnats::generate-new-buffer-name "*not mail*"))
  759.     (rename-buffer buf)))
  760.  
  761. ;; ignore 'free variable' warnings about buf.
  762. (defsubst gnats::vmish-restore-mail-buffer (buf)
  763.   (save-excursion
  764.     (let ((mbuf (get-buffer "*mail*")))
  765.       (cond (mbuf            ;maybe left over from m-o-w failure
  766.          (set-buffer mbuf)
  767.          (set-buffer-modified-p nil)
  768.          (kill-buffer mbuf))))
  769.     (cond (buf
  770.        (set-buffer buf)
  771.        (rename-buffer "*mail*")))))
  772.  
  773. (defun gnats::vmish-mail-other-window
  774.   (&optional buffer-name noerase to subject in-reply-to cc replybuffer actions)
  775.   (let ((buf (get-buffer "*mail*")))
  776.     (if buf (gnats::vmish-rename-mail-buffer buf))
  777.     (or buffer-name (setq buffer-name "GNATS mail"))
  778.     (unwind-protect
  779.     (prog1
  780.         (if gnats::emacs-19p
  781.         (mail-other-window
  782.          noerase to subject in-reply-to cc replybuffer
  783.          (cons '(gnats::vmish-rename-after-send) actions))
  784.           (prog1
  785.           (mail-other-window noerase to subject in-reply-to
  786.                      cc replybuffer)
  787.         (gnats::vmish-mail-bindings)))
  788.       (rename-buffer (gnats::generate-new-buffer-name buffer-name)))
  789.       (gnats::vmish-restore-mail-buffer buf))))
  790.  
  791. (defun gnats::vmish-mail
  792.   (&optional buffer-name noerase to subject in-reply-to cc replybuffer actions)
  793.   (let (buf (get-buffer "*mail*"))
  794.     (if buf (gnats::vmish-rename-mail-buffer buf))
  795.     (or buffer-name (setq buffer-name "GNATS mail"))
  796.     (unwind-protect
  797.     (prog1
  798.         (if gnats::emacs-19p
  799.         (mail noerase to subject in-reply-to cc replybuffer
  800.               (cons '(gnats::vmish-rename-after-send) actions))
  801.           (prog1
  802.           (mail noerase to subject in-reply-to cc replybuffer)
  803.         (gnats::vmish-mail-bindings)))
  804.       (rename-buffer (gnats::generate-new-buffer-name buffer-name)))
  805.       (gnats::vmish-restore-mail-buffer buf))))
  806.  
  807. ;;;; Send mail using mh-e.
  808.  
  809. (defun gnats::mail-other-window-using-mhe ()
  810.   "Compose mail other window using mh-e.
  811. While composing the message, use \\[mh-yank-cur-msg] to yank the
  812. original message into it."
  813.   (let ((subject (gnats::get-reply-subject)))
  814.     (setq mh-show-buffer (current-buffer))
  815.     (mh-find-path)
  816.     (mh-send-other-window "" "" subject)
  817.     (setq mh-sent-from-folder (current-buffer))
  818.     (setq mh-sent-from-msg 1)))
  819.  
  820.  
  821. (defun gnats::mail-reply-using-mhe (just-sender)
  822.   "Compose reply mail using mh-e.
  823. The command \\[mh-yank-cur-msg] yanks the original message into current buffer.
  824. If optional argument JUST-SENDER is non-nil, send response only to
  825. original submitter of problem report."
  826.   ;; First of all, prepare mhe mail buffer.
  827.   (let (from cc subject date to reply-to (buffer (current-buffer)) msg-id)
  828.     (save-restriction
  829.       (setq from     (mh-get-field "From:")
  830.         subject  (gnats::get-reply-subject)
  831.         reply-to (or (mh-get-field "Reply-To:") from)
  832.         to         (or (mh-get-field "To:")
  833.              (mh-get-field "Apparently-To:")
  834.              "")
  835.         cc       (mh-get-field "Cc:")
  836.         date     (mh-get-field "Date:")
  837.         msg-id   (mh-get-field "Message-Id:")
  838.         )
  839.       (setq mh-show-buffer buffer)
  840.       (mh-find-path)
  841.       (mh-send reply-to (or (and just-sender "")
  842.                 (if (null cc) to
  843.                   (concat to ", " cc)))
  844.            subject)
  845.       (save-excursion
  846.     (mh-insert-fields
  847.      "In-Reply-To:" (gnats::make-in-reply-to-field from date msg-id)))
  848.       (setq mh-sent-from-folder buffer)
  849.       (setq mh-sent-from-msg 1)
  850.       )))
  851.  
  852.  
  853. ;;;;---------------------------------------------------------------------------
  854. ;;;; Functions to change specific fields
  855. ;;;;---------------------------------------------------------------------------
  856.  
  857. (defun gnats:state-change-from-to ()
  858.   "Change the value of the `>State:' field and update the audit trail."
  859.   (interactive)
  860.   (gnats:change-field "State"))
  861.  
  862. (defun gnats:responsible-change-from-to ()
  863.   "Change the value of the `>Responsible:' field and update the audit trail."
  864.   (interactive)
  865.   (gnats:change-field "Responsible"))
  866.  
  867. (defun gnats:category-change-from-to ()
  868.   "Change the value of the `>Category:' field and the responsible party."
  869.   (interactive)
  870.   (gnats:change-field "Category"))
  871.  
  872. (defun gnats::update-audit-trail (field old new)
  873.   (if (gnats::position-on-field "Audit-Trail")
  874.       (let (start end)
  875.     (gnats::forward-eofield)
  876.     (setq start (point-marker))
  877.     (if (eq old t) (setq old "????"))
  878.     (if (string= field "Responsible")
  879.         (insert (format "\n\n%s-Changed-From-To: %s->%s" field
  880.                 (gnats::nth-word old)
  881.                 (gnats::nth-word new)))
  882.       (insert (format "\n\n%s-Changed-From-To: %s-%s" field
  883.               (gnats::nth-word old)
  884.               (gnats::nth-word new))))
  885.     (insert (format "\n%s-Changed-By: %s" field (user-login-name)))
  886.     (insert (format "\n%s-Changed-When: %s" field (current-time-string)))
  887.     (insert (format "\n%s-Changed-Why:\n" field))
  888.     (save-excursion
  889.       (gnats::before-keyword t)
  890.       (setq end (point-marker)))
  891.     ;; here we record the changes in a assoc list
  892.     (setq gnats:::audit-trail (cons (list field 
  893.                          (gnats::nth-word old) 
  894.                          (gnats::nth-word new)
  895.                          start end) 
  896.                        gnats:::audit-trail)))
  897.     (error "Field `>Audit-Trail:' missing.")))
  898.  
  899. (defun gnats::category-responsible (category)
  900.   (let ((entry (assoc category gnats::categories)))
  901.     (if entry
  902.     (nth 2 entry)
  903.       (signal 'gnats::no-such-category (list category)))))
  904.           
  905. (defun gnats::update-responsible (ignore1 ignore2 new)
  906.   "Modify the responsible field of the current PR to match the new category."
  907.   (and (y-or-n-p "Update the >Responsible: field? ")
  908.        (gnats:change-field "Responsible" (gnats::category-responsible new))))
  909.  
  910. ;;;;---------------------------------------------------------------------------
  911.  
  912. (defsubst gnats::rw (buf retval)
  913.   (or
  914.    retval                ; call-process is broken under 19.19.2
  915.    (save-excursion (set-buffer buf) (buffer-size))))
  916.  
  917. (defun gnats::handle-results (pr exit-status)
  918.   "Handle the results of running pr-edit or npr-edit, giving a signal
  919. if needed."
  920.   (cond
  921.    ((looking-at "n?pr-edit: cannot create lock file")
  922.     (signal 'gnats::cannot-lock nil))
  923.    ((looking-at "n?pr-edit: lock file exists")
  924.     (signal 'gnats::locked nil))
  925.    ((or (looking-at "n?pr-edit: no such PR")
  926.     (looking-at "n?pr-edit: couldn.t find PR.*"))
  927.     (signal 'gnats::no-such-pr nil))
  928.    ((looking-at "n?pr-edit: PR \\(.*\\) locked by \\(.*\\)")
  929.     (let* ((msg (gnats::bm 2))
  930.        (pr-path
  931.         (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
  932.        (pr-name (progn (if (string-match gnats:root pr-path)
  933.                    (substring pr-path (1+ (match-end 0)))
  934.                  pr-path)))
  935.        (buf (get-buffer pr-name))
  936.        win)
  937.       (if buf
  938.       ;; If we're already editing the PR, just go to that
  939.       ;; buffer and be done with it.
  940.       (progn
  941.         (if (setq win (get-buffer-window buf))
  942.         (select-window win)
  943.           (switch-to-buffer buf))
  944.         (message "Already editing PR %s." pr-name))
  945.     ;; kick it to the next level
  946.     (signal 'gnats::locked-pr (list msg)))))
  947.    ((looking-at "n?pr-edit: PR is not locked")
  948.     (if (not gnats:::force) (signal 'gnats::pr-not-locked nil)
  949.       t))
  950.    ((looking-at "n?pr-edit: invalid fields")
  951.     (signal 'gnats::invalid-fields nil))
  952.    ((looking-at "n?pr-edit: cannot parse the date")
  953.     (signal 'gnats::invalid-date nil))
  954.    ((looking-at "n?pr-edit: lock file .* does not exist"))
  955.    (t (signal 'gnats::error
  956.           (list (if (eq (point-min) (point-max))
  957.             (format "unknown error (exit status %d)"
  958.                 exit-status)
  959.               (buffer-substring (point-min) (- (point-max) 1))))))))
  960.  
  961. (if gnats::emacs-19p
  962.     (require 'env))
  963. (defun gnats::start-background (pr proctype sentinel &optional outfile filep args)
  964.   (let ((buf (get-buffer-create gnats::err-buffer))
  965.     inbuf proc-name proc-action proc-send-buffer)
  966.     (save-excursion
  967.       (setq inbuf (current-buffer))
  968.       (set-buffer buf)
  969.       (erase-buffer)
  970.       (make-variable-buffer-local 'gnats:::force)
  971.       (setq gnats:::force nil)
  972.       (cond ((eq proctype 'check)
  973.          (progn
  974.            (setq proc-name "check-pr"
  975.              proc-action "Checking"
  976.              proc-send-buffer t)
  977.            (setq args (append (list "--check") args))
  978.            (make-variable-buffer-local 'gnats:::pr-buffer)
  979.            (setq gnats:::pr-buffer inbuf)
  980.            (make-variable-buffer-local 'gnats:::do-file-pr)
  981.            (setq gnats:::do-file-pr filep)))
  982.         ((eq proctype 'file)
  983.          (setq proc-name "file-pr"
  984.            proc-action "Filing"
  985.            proc-send-buffer t))
  986.         ((eq proctype 'unlock)
  987.          (progn
  988.            (setq proc-name "unlock-pr"
  989.              proc-action "Unlocking")
  990.            (make-variable-buffer-local 'gnats:::current-pr)
  991.            (setq gnats:::current-pr pr)
  992.            (setq args (append (list "--unlock" pr) args))))
  993.         ((eq proctype 'unlock-force)
  994.          (progn
  995.            (setq proc-name "unlock-pr"
  996.              proc-action "Unlocking"
  997.              gnats:::force t)
  998.            (make-variable-buffer-local 'gnats:::current-pr)
  999.            (setq gnats:::current-pr pr)
  1000.            (setq args (append (list "--unlock" pr) args))))
  1001.         ((eq proctype 'edit)
  1002.          (progn
  1003.            (setq proc-name "edit-pr"
  1004.              proc-action "Fetching")
  1005.            (make-variable-buffer-local 'gnats:::current-pr)
  1006.            (setq gnats:::current-pr pr)
  1007.            (make-variable-buffer-local 'gnats:::newfile)
  1008.            (setq gnats:::newfile outfile)))
  1009.         (t
  1010.          (error "Invalid PROCTYPE for background GNATS process.")))
  1011.       (let ((process-environment 
  1012.          (if gnats::emacs-19p (copy-sequence process-environment)))
  1013.         proc)
  1014.     (setq proc
  1015.           (apply 'start-process
  1016.              (concat " *" proc-name "-" (random t))
  1017.              buf
  1018.              (format (if gnats:network-server
  1019.                  "%s/gnats/npr-edit"
  1020.                    "%s/gnats/pr-edit")
  1021.                  gnats:libdir)
  1022.              (if gnats:network-server 
  1023.             (concat (format  "--host=%s" gnats:network-server) args)
  1024.                args
  1025.                )
  1026.              ))
  1027.  
  1028.     ;; Only set up the sentinel if they want stuff done in the background.
  1029.     (if gnats:run-in-background
  1030.         (progn
  1031.           (set-process-sentinel proc sentinel)
  1032.           (message "%s PR %s in background." proc-action pr))
  1033.       (message "%s PR %s..." proc-action pr))
  1034.     (if proc-send-buffer
  1035.         (progn
  1036.           (set-buffer inbuf)
  1037.           (goto-char (point-min))
  1038.           (process-send-region proc (point-min) (point-max))
  1039.           (if (and (/= (point-min) (point-max))
  1040.                (/= (char-after (- (point-max) 1)) ?\n))
  1041.           (process-send-string proc "\n"))
  1042.           (process-send-eof proc)))
  1043.     ;; if they don't want it in the background, just sit and twiddle...
  1044.     (if (not gnats:run-in-background)
  1045.         (save-excursion
  1046.           (set-buffer (process-buffer proc))
  1047.           (while (memq (process-status proc) '(run open))
  1048.         (accept-process-output proc))
  1049.           (funcall sentinel proc nil)))))))
  1050.  
  1051. (defun gnats::handle-pr-edit (process event)
  1052.   (let ((buf (process-buffer process))
  1053.     result pr newfile nbuf)
  1054.     (if (null (buffer-name buf)) ;; deleted buffer
  1055.     (set-process-buffer process nil)
  1056.       (save-excursion
  1057.     (set-buffer buf)
  1058.     (setq pr gnats:::current-pr)
  1059.     (setq result (process-exit-status process))
  1060.     (and (/= 0 result)
  1061.          (goto-char (point-min))
  1062.          (gnats::handle-results gnats:::current-pr result))
  1063.     (setq nbuf (generate-new-buffer
  1064.             (concat "*edit-pr " gnats:::current-pr "*")))
  1065.     (setq newfile gnats:::newfile)
  1066.     (set-buffer nbuf)
  1067.     (insert-file-contents newfile)
  1068.     (make-local-variable 'gnats:::backupname)
  1069.     (put 'gnats:::backupname 'permanent-local t)
  1070.     ;; we do this in gnats:gnats-mode for non-network
  1071.     (if gnats:network-server (setq gnats:::backupname newfile))
  1072.     (set-buffer-modified-p nil)
  1073.     (setq buffer-undo-list nil) ;flush undo list
  1074.     (gnats:gnats-mode)
  1075.     (make-variable-buffer-local 'gnats:::current-pr)
  1076.     (setq gnats:::current-pr pr)
  1077.     (goto-char gnats:::start-of-PR-fields))
  1078.       (message "Fetching PR %s done." pr)
  1079.       (if gnats:run-in-background
  1080.       (display-buffer nbuf 'not-this-window)
  1081.     (switch-to-buffer nbuf)))))
  1082.  
  1083. (defun gnats::pr-edit-background (pr outfile args)
  1084.   (gnats::start-background pr 'edit 'gnats::handle-pr-edit outfile nil args))
  1085.  
  1086. (defun gnats::handle-check-pr (process event)
  1087.   (let ((buf (process-buffer process))
  1088.     result pr)
  1089.     (if (null (buffer-name buf)) ;; deleted buffer
  1090.     (set-process-buffer process nil)
  1091.       (save-excursion
  1092.     (set-buffer buf)
  1093.     (setq result (process-exit-status process))
  1094.     (and (/= 0 result)
  1095.          (goto-char (point-min))
  1096.          (gnats::handle-results gnats:::current-pr result))
  1097.     (message "Checked PR %s." gnats:::current-pr)
  1098.     (if gnats:::do-file-pr
  1099.         (progn
  1100.           (set-buffer gnats:::pr-buffer)
  1101.           (gnats::file-pr-background)))))))
  1102.  
  1103. (defun gnats::check-pr-background (&optional filep)
  1104.   (gnats::start-background gnats:::current-pr 'check
  1105.               'gnats::handle-check-pr nil filep))
  1106.  
  1107. (defun gnats::finish-filing ()
  1108.   (let (responsible user resp-change state-change buf)
  1109.     (if gnats:network-server (setq gnats:::pr-locked nil))
  1110.     (setq buf (current-buffer))
  1111.     (set-buffer-modified-p nil)
  1112.     (setq responsible  (gnats::field-contents "Responsible")
  1113.       user         (user-login-name)
  1114.       resp-change (cdr (assoc "Responsible" gnats:::audit-trail))
  1115.       state-change (cdr (assoc "State" gnats:::audit-trail)))
  1116.     (if (or state-change
  1117.         resp-change
  1118.         (not (equal user responsible)))
  1119.     (gnats::mail-PR-changed user responsible
  1120.                    resp-change state-change
  1121.                    (gnats::get-header "X-GNATS-Notify")))
  1122.     (gnats:unlock-buffer buf)))
  1123.  
  1124. (defun gnats::handle-file-pr (process event)
  1125.   (let ((buf (process-buffer process))
  1126.     result pr prbuf)
  1127.     (if (null (buffer-name buf)) ;; deleted buffer
  1128.     (set-process-buffer process nil)
  1129.       (save-excursion
  1130.     (set-buffer buf)
  1131.     (setq result (process-exit-status process))
  1132.     (and (/= 0 result)
  1133.          (goto-char (point-min))
  1134.          (gnats::handle-results gnats:::current-pr result))
  1135.     (message "Filed PR %s." gnats:::current-pr)
  1136.     (set-buffer gnats:::pr-buffer)
  1137.     (gnats::finish-filing)))))
  1138.  
  1139. (defun gnats::file-pr-background ()
  1140.   (gnats::start-background gnats:::current-pr 'file 'gnats::handle-file-pr))
  1141.  
  1142. (defun gnats::lock (pr &optional outfile)
  1143.   (let ((lockl (list "--lock"
  1144.         (format "%s@%s" (user-login-name) (system-name))
  1145.         "-p"
  1146.         (if (fboundp 'emacs-pid)
  1147.             (concat "emacs pid " (int-to-string (emacs-pid)))
  1148.           "emacs18")
  1149.         pr)))
  1150.     (if gnats:network-server
  1151.     (setq lockl (append lockl (list "-o" outfile "--get-lists"
  1152.                     "--host" gnats:network-server))))
  1153.     (gnats::pr-edit-background pr outfile lockl)))
  1154.  
  1155. (fset 'unlock-pr 'gnats:unlock-pr)
  1156. (fset 'gnats-unlock 'gnats:unlock-pr)    ;backward compatibility
  1157. (defun gnats::handle-unlock-pr (process event)
  1158.   (let ((buf (process-buffer process))
  1159.     result pr newfile nbuf)
  1160.     (if (null (buffer-name buf)) ;; deleted buffer
  1161.     (set-process-buffer process nil)
  1162.       (save-excursion
  1163.     (set-buffer buf)
  1164.     (setq pr gnats:::current-pr)
  1165.     (setq result (process-exit-status process))
  1166.     (and (/= 0 result)
  1167.          (goto-char (point-min))
  1168.          (gnats::handle-results gnats:::current-pr result))
  1169.     (message "PR %s unlocked." gnats:::current-pr)))))
  1170.  
  1171. (defun gnats:unlock-pr-force (pr)
  1172.   (gnats::start-background pr 'unlock-force 'gnats::handle-unlock-pr))
  1173.  
  1174. (defun gnats:unlock-pr (pr)
  1175.   (interactive "sPR number: ")
  1176.   (gnats::start-background pr 'unlock 'gnats::handle-unlock-pr))
  1177.  
  1178. (defsubst gnats::buffer-major-mode (buffer)
  1179.   (save-excursion (set-buffer buffer) major-mode))
  1180.  
  1181. (defun gnats::unlock-all-buffers ()
  1182.   (save-excursion
  1183.     (mapcar
  1184.      (function
  1185.       (lambda (buffer)
  1186.     (let ((gnats:run-in-background nil))
  1187.       (if (and (eq (gnats::buffer-major-mode buffer) gnats::mode-name))
  1188.           (progn (set-buffer buffer)
  1189.              (gnats:unlock-buffer-force buffer))))))
  1190.      (buffer-list))))
  1191.  
  1192. (if gnats::emacs-19p
  1193.     ;; Emacs 19 has kill-buffer-hook, v18 doesn't.
  1194.     (defun gnats::kill-buffer-hook ()
  1195.       "Unlock a GNATS buffer that is being killed."
  1196.       (gnats:unlock-buffer nil))
  1197.   (defun gnats:kill-buffer (buf)
  1198.     "Safely kill a GNATS buffer."
  1199.     (interactive "bKill buffer: ")
  1200.     (if (equal buf (buffer-name))
  1201.     (gnats:unlock-buffer (get-buffer buf)))
  1202.     (kill-buffer buf)))
  1203.  
  1204. (defun gnats:unlock-buffer-force (&optional buf)
  1205.   "Force a buffer to be unlocked, even if it isn't."
  1206.   (interactive)
  1207.   (if (null buf)
  1208.       (setq buf (current-buffer))
  1209.     (set-buffer buf))
  1210.   (gnats:unlock-buffer buf t))
  1211.  
  1212. (defun gnats::delete-file (filename)
  1213.   (if (file-readable-p filename) (delete-file filename)))
  1214.   
  1215. (defun gnats:unlock-buffer (&optional buf force)
  1216.   "Safely take a GNATS buffer out of gnats-mode."
  1217.   (interactive)
  1218.   (save-excursion
  1219.     (if (null buf)
  1220.     (setq buf (current-buffer))
  1221.       (set-buffer buf))
  1222.     (cond ((or force
  1223.            (not (buffer-modified-p buf))
  1224.            (not gnats:::pr-locked)
  1225.            (y-or-n-p "Buffer modified; still unlock? "))
  1226.        (if gnats:::pr-locked
  1227.            (gnats:unlock-pr-force gnats:::buffer-pr))
  1228.        (if gnats:::pr-errors
  1229.            (kill-buffer gnats:::pr-errors))
  1230.        (if gnats:::backupname
  1231.            (progn
  1232.          (gnats::delete-file gnats:::backupname)
  1233.          (if gnats:network-server
  1234.              (progn
  1235.                (gnats::delete-file (concat gnats:::backupname ".cat"))
  1236.                (gnats::delete-file (concat gnats:::backupname ".res"))
  1237.                (gnats::delete-file (concat gnats:::backupname ".sub"))))))
  1238.        (save-excursion
  1239.          (set-buffer buf)
  1240.          (let ((pr gnats:::buffer-pr))
  1241.            (kill-all-local-variables)
  1242.            (text-mode)
  1243.            (make-local-variable 'gnats:::buffer-pr)
  1244.            (setq gnats:::buffer-pr pr)
  1245.            (use-local-map (copy-keymap (current-local-map)))
  1246.            (local-set-key
  1247.         "e" (function (lambda () (interactive)
  1248.                 (gnats:edit-pr gnats:::buffer-pr))))
  1249.            (set-visited-file-name nil)
  1250.            (setq buffer-read-only t)
  1251.            ;; When GNATS:KEEP-EDITED-BUFFERS is nil, we always put the
  1252.            ;; most recent PR in the *edited-pr* buffer.
  1253.            (or gnats:keep-edited-buffers
  1254.            (let ((old-buf (get-buffer (concat "*edited-pr*"))))
  1255.              (cond (old-buf
  1256.                 (set-buffer old-buf)
  1257.                 (set-buffer-modified-p nil)
  1258.                 (kill-buffer old-buf)))
  1259.              (set-buffer buf)
  1260.              (rename-buffer (concat "*edited-pr*"))))))
  1261.        (and gnats:bury-edited-prs
  1262.         (if (get-buffer-window buf)
  1263.             (let ((win (selected-window)))
  1264.               (select-window (get-buffer-window buf))
  1265.               (bury-buffer)
  1266.               (select-window win))
  1267.           (bury-buffer buf))))
  1268.       (t (error "PR unlock aborted.")))))
  1269.     
  1270. (defun gnats::delete-backups (filename)
  1271.   (let ((l (file-name-all-completions
  1272.         (concat (file-name-nondirectory filename) ".~")
  1273.         (file-name-directory filename)))
  1274.     (dir (file-name-directory filename)))
  1275.     (while l
  1276.       (delete-file (concat dir (car l)))
  1277.       (setq l (cdr l)))))
  1278.  
  1279. (defun gnats::reset-variables ()
  1280.   (setq gnats::submitters nil
  1281.     gnats::responsibles nil
  1282.     gnats::categories nil))
  1283.  
  1284. (defun gnats::set-responsibles (&optional arg)
  1285.   (or (and (null arg) gnats::responsibles)
  1286.       (setq gnats::responsibles
  1287.         (gnats::get-list-from-file
  1288.          (if gnats:network-server
  1289.          "res"
  1290.            "responsible") "responsible")))
  1291.   'gnats::try-responsible-completion)
  1292.  
  1293. (defun gnats::try-responsible-completion (string predicate do-list)
  1294.   (let (entry)
  1295.     (and (not (assoc string gnats::responsibles))
  1296.      (setq entry (gnats::real-pr-addr string))
  1297.      (gnats::push entry gnats::responsibles)))
  1298.   (let* ((completion-ignore-case t))
  1299.     (if do-list
  1300.     (all-completions string gnats::responsibles predicate)
  1301.       (try-completion string gnats::responsibles predicate))))
  1302.  
  1303. (defun gnats::set-categories (&optional arg)
  1304.   (or (and (null arg) gnats::categories)
  1305.       (setq gnats::categories
  1306.         (gnats::get-list-from-file
  1307.          (if gnats:network-server
  1308.          "cat"
  1309.            "categories") "categories"))))
  1310.  
  1311. (defun gnats::set-submitters (&optional arg)
  1312.   (or (and (null arg) gnats::submitters)
  1313.       (setq gnats::submitters
  1314.         (gnats::get-list-from-file
  1315.          (if gnats:network-server
  1316.          "sub"
  1317.            "submitters") "submitters"))))
  1318.  
  1319. (defun gnats::get-list (buffer)
  1320.   (let (result)
  1321.     (save-excursion
  1322.       (set-buffer buffer)
  1323.       (goto-char (point-min))
  1324.       (while (re-search-forward "^[^#:]+" nil t)
  1325.         (gnats::push (list (gnats::bm 0)) result)))
  1326.     (reverse result)))
  1327.  
  1328. (defun gnats::parse-line ()
  1329.   (let ((end (progn (end-of-line) (point)))
  1330.     (p (match-beginning 0))
  1331.     l)
  1332.     (goto-char p)
  1333.     (while (search-forward ":" end 'move)
  1334.       (gnats::push (buffer-substring p (match-beginning 0)) l)
  1335.       (skip-chars-forward " " end)
  1336.       (setq p (point)))
  1337.     (gnats::push (buffer-substring p end) l)
  1338.     (reverse l)))
  1339.  
  1340. (defun gnats::get-alist (buffer)
  1341.   (let (result)
  1342.     (save-excursion
  1343.       (set-buffer buffer)
  1344.       (goto-char (point-min))
  1345.       (while (re-search-forward "^[^#]" nil t)
  1346.     (gnats::push (gnats::parse-line) result)))
  1347.     (reverse result)))
  1348.  
  1349. (defun gnats::get-list-from-file (filename desc)
  1350.   (let ((buf nil)
  1351.     (result nil))
  1352.     (message "Parsing the %s file..." desc)
  1353.     (save-excursion
  1354.       (let ((bn gnats:::backupname))
  1355.     (setq buf (get-buffer-create " *gnats-grok*"))
  1356.     (set-buffer buf)
  1357.     (setq buffer-read-only nil)
  1358.     (erase-buffer)
  1359.     (insert-file-contents
  1360.      (if gnats:network-server
  1361.          (concat bn "." filename)
  1362.        (format "%s/gnats-adm/%s" gnats:root filename)))
  1363.     (setq result (gnats::get-alist buf))
  1364.     (kill-buffer buf))
  1365.       (message "Parsing the %s file...done." desc)
  1366.       result)))
  1367.  
  1368. (defun gnats::get-pr-category (number)
  1369.   "Return the category for the problem report NUMBER."
  1370.   (let ((buf nil)
  1371.     (result nil))
  1372.     (save-excursion
  1373.       (setq buf (get-buffer-create " *gnats-index*"))
  1374.       (set-buffer buf)
  1375.       (setq buffer-read-only nil)
  1376.       (erase-buffer)
  1377.       (insert-file-contents (format "%s/gnats-adm/index" gnats:root))
  1378.       (goto-char (point-min))
  1379.       (setq result
  1380.         (catch 'res
  1381.           (while (search-forward (format "/%s:" number) nil t)
  1382.         (beginning-of-line)
  1383.         (if (looking-at (format "\\([^/]+\\)/%s:" number))
  1384.             (throw 'res (gnats::bm 1))
  1385.           (end-of-line)))
  1386.           nil))
  1387.       (kill-buffer buf))
  1388.     (or result (signal 'gnats::no-such-pr (list number)))))
  1389.  
  1390. (defsubst gnats::has-slash (string)
  1391.   (memq t (mapcar (function (lambda (char) (= char ?/))) string)))
  1392.  
  1393. (or (boundp 'view-hook) (setq view-hook nil))
  1394.  
  1395. ;;;###autoload
  1396. (fset 'view-pr 'gnats:view-pr)
  1397. ;;;###autoload
  1398. (defun gnats:view-pr (&optional id)
  1399.   "Visit the problem report named by the string ID.  While viewing, press
  1400. 'e' to edit the currently viewed PR."
  1401.   (interactive "sPR number: ")
  1402.   (let (pr category temp-name buffer)
  1403.     (if (string= id "")
  1404.     (message "view-pr: must specify a PR")
  1405.       (if (or (gnats::has-slash id) gnats:network-server)
  1406.       (setq pr id)
  1407.     (and (setq category (gnats::get-pr-category id))
  1408.          (setq pr (format "%s/%s" category id))))
  1409.       (let ((view-hook (default-value 'view-hook))
  1410.         buf func)
  1411.     (if (and pr
  1412.          (or gnats:network-server
  1413.              (setq buf (get-buffer pr))
  1414.              (file-exists-p (format "%s/%s" gnats:root pr))))
  1415.         (if buf
  1416.         (save-excursion
  1417.           (set-buffer buf)
  1418.           (goto-char (point-min))
  1419.           (view-buffer buf))
  1420.           (setq func
  1421.             (function
  1422.              (lambda ()
  1423.                (and gnats::emacs-19p (rename-buffer pr))
  1424.                (setq mode-line-buffer-identification
  1425.                  (format "Viewing %s" pr))
  1426.                (make-local-variable 'gnats:::buffer-pr)
  1427.                (setq gnats:::buffer-pr pr)
  1428.                (use-local-map (copy-keymap (current-local-map)))
  1429.                (local-set-key
  1430.             "e"
  1431.             (function (lambda () (interactive)
  1432.                     (gnats:edit-pr gnats:::buffer-pr)))))))
  1433.           (if (fboundp 'add-hook)
  1434.           (add-hook 'view-hook func)
  1435.         (setq view-hook func))
  1436.           (if gnats:network-server
  1437.           (gnats:net-view-pr id buf)
  1438.         (view-file (format "%s/%s" gnats:root pr))))
  1439.       (signal 'gnats::no-such-pr (list id)))))))
  1440.  
  1441. (defun gnats:net-view-pr (id buf)
  1442.   "Use the network query to view problem report ID."
  1443.   (require 'view)
  1444.   (let ((result nil)
  1445.     (curr (current-buffer)))
  1446.     (unwind-protect
  1447.     (if (not buf)
  1448.         (progn
  1449.           ;; XXX fix this to include the category
  1450.           (setq buf (get-buffer-create (concat "*view-pr " id "*")))
  1451.           (setq buffer-read-only nil)))
  1452.       (let ((command (append (list 'funcall)
  1453.                  (list ''call-process)
  1454.                    (list gnats:::nquery-pr nil buf nil)
  1455.                    (list id "--full" "--host"
  1456.                      gnats:network-server))))
  1457.       (save-excursion
  1458.         (set-buffer buf)
  1459.         (erase-buffer))
  1460.       (let ((default-directory (gnats::find-safe-default-directory)))
  1461.         (setq result (gnats::rw buf (eval command))))
  1462.       (save-excursion
  1463.         (set-buffer buf)
  1464.         (and (/= 0 result)
  1465.          (goto-char (point-min))
  1466.          (cond
  1467.           ((or (looking-at (concat gnats:::query-regexp " no PRs matched"))
  1468.                (looking-at (concat gnats:::query-regexp " couldn.t find PR.*")))
  1469.            (signal 'gnats::no-such-pr nil))
  1470.           (t (signal 'gnats::error
  1471.                  (list (buffer-substring (point-min)
  1472.                              (- (point-max) 1)))))
  1473.           ))))
  1474.       (switch-to-buffer buf)
  1475.       (if (fboundp 'view-mode-enter)
  1476.       (view-mode-enter curr 'kill-buffer)
  1477.     (view-mode curr 'kill-buffer))
  1478.       (set-buffer-modified-p nil)
  1479.       (make-local-variable 'gnats:::buffer-pr)
  1480.       (if (not (gnats::has-slash id)) (gnats::rename-buffer))
  1481.       (setq buffer-read-only t)
  1482.       (setq buffer-undo-list nil) ;flush undo list
  1483.       (goto-char (point-min)))
  1484.     (zerop result)))
  1485.  
  1486. (fset 'change-gnats 'gnats:change-type)
  1487. (fset 'gnats-change-type 'gnats:change-type)
  1488. (defun gnats:change-type (type)
  1489.   "Change the GNATS database type in use."
  1490.   (interactive
  1491.    (list
  1492.     (progn
  1493.       (if (not gnats:::types)
  1494.       (error "Value of gnats:::types has to be non-nil."))
  1495.       (let* ((completion-ignore-case t))
  1496.     (completing-read "Use GNATS database type: " gnats:::types nil t)))))
  1497.   (let ((newlist (car (cdr (assoc type gnats:::types)))))
  1498.     (setq gnats:root (car newlist)
  1499.       gnats:libdir (car (cdr newlist))
  1500.       gnats:::query-pr (car (cdr (cdr newlist)))
  1501.       gnats:::nquery-pr (car (cdr (cdr (cdr newlist))))
  1502.       gnats:::query-regexp (car (cdr (cdr (cdr (cdr newlist)))))
  1503.       )
  1504.     (gnats::reset-variables)))
  1505.  
  1506. (defun gnats::find-pr-buffer (pr)
  1507. "*Find the buffer currently editing PR, returning the buffer or nil."
  1508.   (if (gnats::has-slash pr)
  1509.       ;; return the buffer if it exists
  1510.       (get-buffer pr)
  1511.     (let (buflist buf
  1512.       (name (concat "/" pr "$")))
  1513.       (setq buflist
  1514.         (delq nil
  1515.           (mapcar
  1516.            (function (lambda (buf)
  1517.                    (if (string-match name (buffer-name buf))
  1518.                    buf)))
  1519.            (buffer-list))))
  1520.       ;; If we found one---and only one---then sanity-check some things
  1521.       ;; about it before we try to use it.
  1522.       (if (eq (length buflist) 1)
  1523.       (progn
  1524.         (setq buf (car buflist))
  1525.         (save-excursion
  1526.           (set-buffer buf)
  1527.           ;; We make sure that we have a value for the PR, it's in
  1528.           ;; the right mode, and that the buffer's writable.  If so,
  1529.           ;; we'll return the buffer, otherwise the result of the if
  1530.           ;; gets kicked back up to return nil.
  1531.           (if (and gnats:::buffer-pr
  1532.                (eq major-mode 'gnats:gnats-mode)
  1533.                (eq buffer-read-only nil))
  1534.           buf)))))))
  1535.  
  1536. ;;;###autoload
  1537. (fset 'edit-pr 'gnats:edit-pr)
  1538. ;;;###autoload
  1539. (defun gnats:edit-pr (&optional id)
  1540.   "Edit the problem report named by the string ID."
  1541.   (interactive "sPR number: ")
  1542.   (if (string= id "")
  1543.       (message "edit-pr: must specify a PR to edit")
  1544.     (let (pr category newfile
  1545.          (buf (gnats::find-pr-buffer id)))
  1546.       (if buf
  1547.       (progn
  1548.         (switch-to-buffer buf)
  1549.         (message "Already editing PR %s." id))
  1550.     (progn
  1551.       (if (or (gnats::has-slash id) gnats:network-server)
  1552.           (setq pr id)
  1553.         (and (setq category (gnats::get-pr-category id))
  1554.          (setq pr (format "%s/%s" category id)))))
  1555.     (if (and pr (or gnats:network-server
  1556.             (file-exists-p (format "%s/%s" gnats:root pr))))
  1557.         (progn
  1558.           (setq newfile (if gnats:network-server
  1559.                 (gnats::make-temp-name)
  1560.                   (format "%s/%s" gnats:root pr)))
  1561.           (gnats::lock pr newfile))
  1562.       (signal 'gnats::no-such-pr (list id)))))))
  1563.  
  1564. (defvar gnats:query-pr-default-options nil
  1565.   "*Default options to pass to query-pr.")
  1566. (defsubst gnats::query-pr-default-options ()
  1567.   (or gnats:query-pr-default-options
  1568.       (if (not gnats:network-server)
  1569.       (concat " --directory=" gnats:root " --print-path ")
  1570.     "")))
  1571.  
  1572. ;;;###autoload
  1573. (fset 'query-pr 'gnats:query-pr)
  1574. ;;;###autoload
  1575. (defun gnats:query-pr (options)
  1576.   "Run query-pr, with user-specified args, and collect output in a buffer.
  1577. While query-pr runs asynchronously, you can use the \\[next-error] command
  1578. to find the text that the hits refer to."
  1579.   (interactive
  1580.    (list (apply
  1581.       'read-from-minibuffer "Run query-pr (with args): "
  1582.       (if gnats::emacs-19p
  1583.           (list (cons (gnats::query-pr-default-options) 1)
  1584.             nil nil 'gnats::query-pr-history)
  1585.         (list (gnats::query-pr-default-options) nil nil)))))
  1586.   (require 'compile)
  1587.   (compile-internal (concat
  1588.              (if gnats:network-server
  1589.              (format (concat gnats:::nquery-pr " --host %s ")
  1590.                  gnats:network-server)
  1591.                (concat gnats:::query-pr " "))
  1592.              options)
  1593.             "No more query-pr hits" (concat gnats:::query-pr " ")))
  1594.  
  1595. (defun gnats::tr (string from to)
  1596.   (let ((s (copy-sequence string))
  1597.     (len (length string)))
  1598.     (while (>= (setq len (1- len)) 0)
  1599.       (if (eq (aref s len) (string-to-char from))
  1600.       (aset s len (string-to-char to))))
  1601.     s))
  1602.  
  1603. ;; Redefine so that buffers with, say, g++/1234 embedded in them can be
  1604. ;; autosaved.  This was mostly copied from the Emacs 19.19 version.
  1605. (defun gnats::make-auto-save-file-name ()
  1606.   "Return file name to use for auto-saves of current buffer.
  1607. Does not consider `auto-save-visited-file-name' as that variable is checked
  1608. before calling this function.  You can redefine this for customization.
  1609. See also `auto-save-file-name-p'."
  1610.   ; Since the user may have his own make-auto-save-file-name, try not to
  1611.   ; use our custom one unless we have to.
  1612.   (if (or (eq major-mode gnats::mode-name)
  1613.        ; Heuristic for noticing a mail buffer based on a PR
  1614.        (string-match " PR .*/" (buffer-name)))
  1615.       (if buffer-file-name
  1616.       (concat (file-name-directory buffer-file-name)
  1617.           "#"
  1618.           (file-name-nondirectory buffer-file-name)
  1619.           "#")
  1620.     ;; For non-file bfr, use bfr name and Emacs pid.
  1621.     (expand-file-name (format "#%s#%s#"
  1622.                   (gnats::tr (buffer-name) "/" ":")
  1623.                   (make-temp-name ""))))
  1624.     (gnats::real-make-auto-save-file-name)))
  1625.  
  1626. (if (not (fboundp 'gnats::real-make-auto-save-file-name))
  1627.     (progn (fset 'gnats::real-make-auto-save-file-name 
  1628.          (symbol-function 'make-auto-save-file-name))
  1629.         (fset 'make-auto-save-file-name 'gnats::make-auto-save-file-name)))
  1630.  
  1631. (defun gnats::make-temp-name ()
  1632.   (make-temp-name
  1633.    (concat (expand-file-name (file-name-as-directory gnats::tmpdir)) "gnats")))
  1634.   
  1635. ;; Below this is the GNATS summary mode I've written.  Not quite 100%
  1636. ;; integrated yet.
  1637.  
  1638. ;; Temporary variables which are made buffer-local, but which the byte
  1639. ;; compiler complaints about if the defvars aren't here.
  1640. (defvar gnats:::PRs nil
  1641.   "List of problem reports to be summarized.  This variable is buffer local.")
  1642. (make-variable-buffer-local 'gnats:::PRs)
  1643. (defvar gnats::options nil
  1644.   "Options used for nquery-pr in the current GNATS summary buffer.
  1645. This variable is buffer local.")
  1646. (make-variable-buffer-local 'gnats::options)
  1647.  
  1648. ;; Note: "release" stays out of this list.  The "release" field is
  1649. ;; unrestricted; the customer could put any old junk in there, and
  1650. ;; often does.
  1651. (defvar gnats:::limited-fields '(category confidential severity priority responsible state class customer-id)
  1652.   "PR fields for which the possible values are limited in range.")
  1653.  
  1654. (defvar gnats::summary-sort-function nil
  1655.   "Holds a function used to filter and sort PRs before displaying a report.
  1656. This filtering does not affect the stored PR information, so an invocation
  1657. of gnats:summary-redisplay after changing this variable will do the right thing.")
  1658.  
  1659. (defun gnats:::prompt-for-pr-number (default)
  1660.   (let ((val (read-input (if default
  1661.                  (format "PR number (default %d): " default)
  1662.                "PR number: "))))
  1663.     (if (and default (string= val ""))
  1664.     default
  1665.       (setq val (string-to-number val))
  1666.       (if (and (integerp val)
  1667.            (> val 0))
  1668.       val
  1669.     (error "PR number must be a positive integer.")))))
  1670.  
  1671. (defun gnats:summary-edit (num)
  1672.   "Edit the PR referenced by the current text, or get a PR number from user.
  1673. If a numeric prefix is given, it is used as the PR number.
  1674. If a non-numeric prefix is given, or the text at (point) doesn't have the
  1675. gnats::pr-number property, the user is prompted for a PR number."
  1676.   (interactive (list
  1677.         (let ((x (get-text-property (point) 'gnats::pr-number)))
  1678.           (cond ((numberp current-prefix-arg) current-prefix-arg)
  1679.             (current-prefix-arg (gnats:::prompt-for-pr-number x))
  1680.             (x x)
  1681.             (t (gnats:::prompt-for-pr-number nil))))))
  1682.   (message "Editing PR %d..." num)
  1683.   (gnats:edit-pr (number-to-string num)))
  1684.  
  1685. (defun gnats:summary-view (num)
  1686.   "View the PR referenced by the current text, or get a PR number from user.
  1687. If a numeric prefix is given, it is used as the PR number.
  1688. If a non-numeric prefix is given, or the text at (point) doesn't have the
  1689. gnats::pr-number property, the user is prompted for a PR number."
  1690.   (interactive (list
  1691.         (let ((x (get-text-property (point) 'gnats::pr-number)))
  1692.           (cond ((numberp current-prefix-arg) current-prefix-arg)
  1693.             (current-prefix-arg (gnats:::prompt-for-pr-number x))
  1694.             (x x)
  1695.             (t (gnats:::prompt-for-pr-number nil))))))
  1696.   (message "Viewing PR %d..." num)
  1697.   (gnats:view-pr (number-to-string num)))
  1698.  
  1699. (defun gnats:summary-quit nil
  1700.   "Quit GNATS summary mode."
  1701.   (interactive)
  1702.   (kill-buffer nil))
  1703.  
  1704. (defun gnats:summary-revert nil
  1705.   "Fetch PR data from server and rebuild the summary."
  1706.   (interactive)
  1707.   (gnats:summ-pr gnats::options))
  1708.  
  1709. ;; Fetch field value from a PR.
  1710. (defsubst gnats:::fieldval (pr field)
  1711.   (let ((x (assq field pr)))
  1712.     (if x (cdr x) nil)))
  1713.  
  1714. ;; Taken from gnus-parse-simple-format in (ding)Gnus 0.88.
  1715. ;; Extended to handle width-1 fields more efficiently.
  1716. ;; Extended to permit "*" to flag truncation.
  1717. ;; Modified to call kqpr* functions instead of gnus-*.
  1718. (defun gnats:::parse-summary-format (format spec-alist)
  1719.   ;; This function parses the FORMAT string with the help of the
  1720.   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
  1721.   ;; string. The list will consist of the symbol `format', a format
  1722.   ;; specification string, and a list of forms depending on the
  1723.   ;; SPEC-ALIST.
  1724.   (let ((max-width 0)
  1725.     spec flist fstring b newspec max-width elem beg trunc-noisy)
  1726.     (save-excursion
  1727.       (set-buffer (get-buffer-create " *qpr work*"))
  1728.       (erase-buffer)
  1729.       (insert format)
  1730.       (goto-char (point-min))
  1731.       (while (re-search-forward "%-?[0-9]*\\([,*]-?[0-9]*\\)*\\(.\\)\\(.\\)?" nil t)
  1732.     (setq spec (string-to-char (buffer-substring (match-beginning 2)
  1733.                              (match-end 2))))
  1734.     ;; First check if there are any specs that look anything like
  1735.     ;; "%12,12A", ie. with a "max width specification". These have
  1736.     ;; to be treated specially.
  1737.     (if (setq beg (match-beginning 1))
  1738.         (setq max-width 
  1739.           (string-to-int 
  1740.            (buffer-substring (1+ (match-beginning 1)) (match-end 1)))
  1741.           trunc-noisy (= ?* (char-after beg)))
  1742.       (setq max-width 0)
  1743.       (setq beg (match-beginning 2))
  1744.       (setq trunc-noisy nil))
  1745.     ;; Find the specification from `spec-alist'.
  1746.     (if (not (setq elem (cdr (assq spec spec-alist))))
  1747.         (setq elem '("*" ?s)))
  1748.     ;; Treat user defined format specifiers specially
  1749.     (and (eq (car elem) 'user-defined)
  1750.          (setq elem
  1751.            (list 
  1752.             (list (intern (concat "gnats:user-format-function-"
  1753.                       (buffer-substring
  1754.                        (match-beginning 3)
  1755.                        (match-end 3))))
  1756.               'pr)
  1757.             ?s))
  1758.          (delete-region (match-beginning 3) (match-end 3)))
  1759.     (if (not (zerop max-width))
  1760.         (if (and (= max-width 1)
  1761.              (memq (car (cdr elem)) '(?c ?s)))
  1762.         (let ((el (car elem)))
  1763.           (cond ((= (car (cdr elem)) ?c)
  1764.              (setq newspec ?c)
  1765.              (setq flist (cons el flist)))
  1766.             ((= (car (cdr elem)) ?s)
  1767.              (setq newspec ?c)
  1768.              (setq flist (cons (list 'string-to-char el) flist)))
  1769.             (t
  1770.              (error "eep!"))))
  1771.           (let ((el (car elem)))
  1772.         (cond ((= (car (cdr elem)) ?c) 
  1773.                (setq el (list 'char-to-string el)))
  1774.               ((= (car (cdr elem)) ?d)
  1775.                (numberp el) (setq el (list 'int-to-string el))))
  1776.         (setq flist (cons (list 'gnats:::format-max-width
  1777.                     el max-width trunc-noisy)
  1778.                   flist))
  1779.         (setq newspec ?s)))
  1780.       (setq flist (cons (car elem) flist))
  1781.       (setq newspec (car (cdr elem))))
  1782.     ;; Remove the old specification (and possibly a ",12" string).
  1783.     (delete-region beg (match-end 2))
  1784.     ;; Insert the new specification.
  1785.     (goto-char beg)
  1786.     (insert newspec))
  1787.       (setq fstring (buffer-substring 1 (point-max)))
  1788.       (kill-buffer nil))
  1789.     (cons 'format (cons fstring (nreverse flist)))))
  1790.  
  1791. ;; Try to keep this list similar to the command-line options for nquery-pr,
  1792. ;; just to avoid confusing people.  If there are differences, it won't break
  1793. ;; anything.
  1794. (defvar gnats::summary-format-alist
  1795.   (list (list ?r '(symbol-name (gnats:::fieldval pr 'responsible)) ?s)
  1796.     (list ?c '(symbol-name (gnats:::fieldval pr 'category)) ?s)
  1797.     (list ?C '(symbol-name (gnats:::fieldval pr 'confidential)) ?s)
  1798.     (list ?e '(symbol-name (gnats:::fieldval pr 'severity)) ?s)
  1799.     (list ?O '(gnats:::fieldval pr 'originator) ?s)
  1800.     (list ?p '(symbol-name (gnats:::fieldval pr 'priority)) ?s)
  1801.     (list ?L '(symbol-name (gnats:::fieldval pr 'class)) ?s)
  1802.     (list ?S '(symbol-name (gnats:::fieldval pr 'customer-id)) ?s) ; == submitter
  1803.     (list ?s '(symbol-name (gnats:::fieldval pr 'state)) ?s)
  1804.  
  1805.     (list ?n '(gnats:::fieldval pr 'number) ?d)
  1806.     (list ?R '(gnats:::fieldval pr 'release) ?s)
  1807.     (list ?j '(gnats:::fieldval pr 'synopsis) ?s)
  1808.     (list ?y '(gnats:::fieldval pr 'synopsis) ?s)
  1809.     (list ?u 'user-defined ?s)
  1810.     ))
  1811.  
  1812. (defun gnats:::format-max-width (str len noisy)
  1813.   (if (> (length str) (if gnats::emacs-19p (abs len) len))
  1814.       (if noisy
  1815.       (if (< len 0)
  1816.           (concat "*" (substring str (1+ len)))
  1817.         (concat (substring str 0 (- len 1)) "*"))
  1818.     (if (< len 0)
  1819.         (substring str len)
  1820.       (substring str 0 len)))
  1821.     str))
  1822.  
  1823. ;; Redisplay the summary in the current buffer.
  1824. (defvar gnats::format-string
  1825.   "%5n %-4,4c %,1e%,1p %-8,8r %,2s %-10*10S %-10*-10R %j\n"
  1826.   "Format string for PR summary text.
  1827.  
  1828. If you've used format strings in (ding)Gnus, this will be familiar.
  1829.  
  1830. Most text is copied straight through verbatim.  Use \"%\" to indicate a
  1831. non-fixed field.
  1832.  
  1833. It can be followed by a number, indicating minimum width, a separator character
  1834. (\",\" or \"*\"), and another number, indicating maximum width.  These fields
  1835. are optional, except that the separator must be present if the maximum width is
  1836. specified.  Whitespace padding will be on the left unless the first number is
  1837. negative.  Truncation of the field will be done on the right, unless the second
  1838. number is negative.  If the separator character is \"*\", a \"*\" will be used
  1839. to indicate that truncation has been done; otherwise, it will be done silently.
  1840.  
  1841. After the \"%\" and optional width parameters, a letter is expected.  Most of
  1842. the letters are chosen to match the command-line options of `nquery-pr'.
  1843.  
  1844. %r    \"Responsible\" field.
  1845. %c    \"Category\" field.
  1846. %C    \"Confidential\" field.
  1847. %e    \"Severity\" field.
  1848. %O    \"Originator\" field.
  1849. %p    \"Priority\" field.
  1850. %L    \"Class\" field.
  1851. %S    \"Customer-id\" (\"submitter\") field.
  1852. %s    \"State\" field.
  1853. %n    \"Number\" field.
  1854. %R    \"Release\" field.
  1855. %j, %y    \"Synopsis\" field.  (\"j\" as in \"subJect\")
  1856. %u    Special: The next character is examined, and the function
  1857.     gnats:user-format-function-<char> is invoked.  One argument, the list
  1858.     of (FIELD . VALUE) pairs, is passed.
  1859.  
  1860. Any newlines you wish to have used must be included in this string; no
  1861. additional ones will be provided.
  1862.  
  1863. If the value is not a string, it is assumed to be a function which can
  1864. be funcalled to return a format string, to be interpreted as above.")
  1865.  
  1866. (defun gnats:summary-redisplay nil
  1867.   "Redisplay summary of stored GNATS data.
  1868. This is useful if you change your filtering criteria or format string but
  1869. do not wish to update the GNATS data by contacting the server."
  1870.   (interactive)
  1871.   (let (prs
  1872.     (buffer-read-only nil)
  1873.     format-form fmt)
  1874.     ;; Do this early, so if we're in the wrong buffer we blow up without
  1875.     ;; trashing the user's data.
  1876.     (setq prs (if gnats::summary-sort-function
  1877.           (funcall gnats::summary-sort-function
  1878.                (apply 'list gnats:::PRs))
  1879.         gnats:::PRs))
  1880.     ;; No wrapping -- ick!
  1881.     (if gnats::emacs-19p
  1882.     (buffer-disable-undo)
  1883.       (buffer-flush-undo (current-buffer)))
  1884.     (erase-buffer)
  1885.     (setq fmt (if (stringp gnats::format-string)
  1886.           gnats::format-string
  1887.         (funcall gnats::format-string)))
  1888.     (setq format-form (gnats:::parse-summary-format fmt
  1889.                            gnats::summary-format-alist))
  1890.     (mapcar (function
  1891.          (lambda (pr)
  1892.            (let ((start (point)))
  1893.          (insert (eval format-form))
  1894.          ;; Magic.
  1895.          (put-text-property start (point) 'gnats::pr-number
  1896.                     (gnats:::fieldval pr 'number))
  1897.          )))
  1898.         prs)
  1899.     (goto-char (point-min))
  1900.     (buffer-enable-undo)
  1901.     (set-buffer-modified-p nil)
  1902.     ))
  1903.  
  1904. (defvar gnats-summary-mode-map
  1905.   (let ((map (copy-keymap text-mode-map)))
  1906.     (if gnats::emacs-19p (suppress-keymap map))
  1907.     ;; basic mode stuff
  1908.     (define-key map "g" 'gnats:summary-revert)
  1909.     (define-key map "q" 'gnats:summary-quit)
  1910.     (define-key map "r" 'gnats:summary-redisplay)
  1911.     ;; do stuff to PRs
  1912.     (define-key map "e" 'gnats:summary-edit)
  1913.     (define-key map "v" 'gnats:summary-view)
  1914.     ;; navigation
  1915.     (define-key map "n" 'next-line)
  1916.     (define-key map "p" 'previous-line)
  1917.     map)
  1918.   "Keymap for GNATS summary mode.")
  1919.  
  1920. (defun gnats-summary-mode nil
  1921.   "Major mode for problem report summary.
  1922.  
  1923. You can use \\[gnats:summary-view] to view the PR specified by the
  1924. current line, or \\[gnats:summary-edit] to edit it.  Typing
  1925. \\[gnats:summary-revert] will update the PR list.
  1926.  
  1927. Special commands:
  1928. \\{gnats-summary-mode-map}
  1929.  
  1930. Entering GNATS summary mode will invoke any hooks listed in the variable
  1931. gnats-summary-mode-hook.  It will also use text-mode-hook, since the summary
  1932. mode is built on top of text mode."
  1933.   (interactive)
  1934.   (text-mode)
  1935. ;  (make-local-variable 'gnats:::PRs)
  1936. ;  (make-local-variable 'gnats::options)
  1937.   (setq buffer-read-only t)
  1938.   (setq truncate-lines t)
  1939.   (setq major-mode 'gnats-summary-mode)
  1940.   (setq mode-name "GNATS Summary")
  1941.   (use-local-map gnats-summary-mode-map)
  1942.   (run-hooks 'gnats-summary-mode-hook)
  1943.   )
  1944.  
  1945. ;;;###autoload
  1946. (fset 'summ-pr 'gnats:summ-pr)
  1947. ;;;###autoload
  1948. (defun gnats:summ-pr (options)
  1949.   "Run query-pr, with user-specified args, and display a pretty summary.
  1950. Well, display a summary, at least."
  1951.   (interactive
  1952.    (list
  1953.     (if (not gnats::emacs-19p)
  1954.     (error "GNATS summary mode will only work with emacs 19.")
  1955.       (apply
  1956.        'read-from-minibuffer "Run query-pr (with args): "
  1957.        (if gnats::emacs-19p
  1958.        (list (cons (gnats::query-pr-default-options) 1)
  1959.          nil nil 'gnats::query-pr-history)
  1960.      (list (gnats::query-pr-default-options) nil nil))))))
  1961.   (let ((buf (get-buffer-create "*gnats-summ-pr-temp*"))
  1962.     (prs nil)
  1963.     pr fieldname value p)
  1964. ;    (save-excursion
  1965.       (set-buffer buf)
  1966.       (if gnats::emacs-19p
  1967.       (buffer-disable-undo)
  1968.     (buffer-flush-undo buf))
  1969.       (erase-buffer)
  1970.       ;; calling nquery-pr directly would be better, but I'd need a "split"
  1971.       ;; function of some sort to break apart the options string.
  1972.       (message "Fetching GNATS data...")
  1973.       (call-process "sh" nil buf nil "-c"
  1974.             (concat
  1975.              (if gnats:network-server
  1976.              (format (concat gnats:::nquery-pr " --host %s ")
  1977.                      gnats:network-server)
  1978.                (concat gnats:::query-pr " "))
  1979.              options))
  1980.       ;; um, okay, how to i check for errors?
  1981.       (goto-char (point-min))
  1982.       (setq pr nil)
  1983.       (while (looking-at "ld.so: warning:")
  1984.     (forward-line 1))
  1985.       (while (not (eobp))
  1986.     (while (looking-at ">\\([a-zA-Z-]+\\):")
  1987.       (setq fieldname (intern
  1988.                (downcase
  1989.                 (buffer-substring (match-beginning 1)
  1990.                           (match-end 1)))))
  1991.       (goto-char (match-end 0))
  1992.       (while (looking-at "[ \t]")
  1993.         (forward-char 1))
  1994.       (setq p (point))
  1995.       (setq value (buffer-substring p (progn (end-of-line) (point))))
  1996.       (cond ((eq fieldname 'number)
  1997.          (setq value (string-to-number value)))
  1998.         ((memq fieldname gnats:::limited-fields)
  1999.          (setq value (intern value))))
  2000.       (setq pr (cons (cons fieldname value) pr))
  2001.       (forward-char 1))
  2002.     (if (looking-at "\n")
  2003.         (progn
  2004.           (setq prs (cons (nreverse pr) prs)
  2005.             pr nil)
  2006.           (forward-char 1)))
  2007.     ;; could be the result of --print-path
  2008.     (if (looking-at "/.*:0:$")
  2009.         (next-line 1))
  2010.     (if (looking-at gnats:::query-regexp)
  2011.         ;; error message
  2012.         (progn
  2013.           (goto-char (match-end 0))
  2014.           (while (looking-at "[ \t]")
  2015.         (forward-char 1))
  2016.           (setq p (point))
  2017.           (end-of-line)
  2018.           (setq value (buffer-substring p (point)))
  2019.           (error "Database query failed: %s" value)))
  2020.     )
  2021.       (if pr
  2022.       (setq prs (cons (nreverse pr) prs)))
  2023.       (setq prs (nreverse prs))
  2024.  
  2025.       ;; okay, now display it
  2026.       (pop-to-buffer (get-buffer-create "*gnats:summ-pr*"))
  2027.       (gnats-summary-mode)
  2028.       (setq gnats:::PRs prs)
  2029.       (setq gnats::options options)
  2030.       (gnats:summary-redisplay)
  2031.       (message "Fetching GNATS data...done.")
  2032. ;      )
  2033.     (kill-buffer buf)
  2034.     ))
  2035.  
  2036. ;;;; end of gnats.el
  2037.